home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sound.swg / 0020_Detect Adlib Sound Card.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-07-16  |  1.8 KB  |  49 lines
  1. ===========================================================================
  2.  BBS: Canada Remote Systems
  3. Date: 06-25-93 (17:55)             Number: 27742
  4. From: T.C. DOYLE                   Refer#: NONE
  5.   To: ALL                           Recvd: NO  
  6. Subj: Pascal Code How To Detect      Conf: (1221) F-PASCAL
  7. ---------------------------------------------------------------------------
  8.  I found this in the shareware echo...hmm...wrong place:)
  9.  So I decided to forward this message here:
  10.  
  11.  
  12.  
  13.  * Originally By: Mark Shadaram
  14.  * Originally To: All
  15.  * Originally Re: Pascal Code How To Detect Adlib Sound Card
  16.  * Original Area: <FIDO> Shareware Forum
  17.  * Forwarded by : Blue Wave v2.12
  18.  
  19. { How to Detect Adlib Sound Card}
  20. { Coded By Mark Shadaram ( mark.shadaram@oubbs.telecom.uoknor.edu)}
  21. Procedure SetAdlib(Address, Data:Byte);  VAR X,I:Byte;
  22. BEGIN Port[$388]:=Address;
  23.       for I:= 1 to 6 do X:=Port[$388];  {Delay}
  24.       Port[$389]:=Data;
  25.       for I:= 1 to 35 do X:=Port[$388]; {Delay}
  26. END;
  27. Function DetectAdlib:Boolean; VAR X,X2:Byte;
  28. BEGIN SetAdlib($4,$60);                  {Step 1}
  29.       SetAdlib($4,$80);                  {Step 2}
  30.       Delay(10);{Just to make sure!}
  31.       X:=Port[$388];                     {Step 3}
  32.       SetAdlib($2,$ff);                  {Step 4}
  33.       SetAdlib($4,$21);                  {Step 5}
  34.       Delay(10);{Just to make sure!}     {Step 6}
  35.       X2:=Port[$388];                    {Step 7}
  36.       SetAdlib($4,$60);                  {Step 8}
  37.       SetAdlib($4,$80);
  38.       X:= X AND $E0;                     {Step 9}
  39.       X2:= X2 AND $E0;
  40.       IF (X =$0) AND (X2 =$C0) THEN
  41.       DetectAdlib:=TRUE ELSE DetectAdlib:=FALSE;
  42. END;
  43.  
  44. -!- Tag 2.6e + FMail 0.94
  45.  ! Origin: NightShift / Wichita Falls, TX (817)855-1526 (1:3805/13)
  46.  
  47. --- GEcho/Telegard
  48.  * Origin: Never mind the bollocks here's TEROX BBS (1:120/324.0)
  49.